perm filename GRAPHS.PAL[HAL,HE]4 blob sn#158958 filedate 1975-05-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL Graph routines
C00004 00003	 NXTTIM
C00005 00004	ROUTINE INVLDT,<INV.ND>
C00006 00005	ROUTINE CHANGE,<CHG.ND,CHG.VNEW>
C00008 00006	  GETVAL, GETVR0
C00009 00007	 EVALND, EVLCLC
C00011 00008	ROUTINE ADDCLC,<ADD.ND,ADD.CLC>
C00012 00009	  MAKEGN, DELGN
C00016 00010	 DELCLC, RLLST1, RLLST2
C00018 00011	GET2WD & GET3WD 
C00019 00012	 RF -- This is RHT's, temporarily commented out.
C00021 ENDMK
C⊗;
.SBTTL Graph routines

;Graph structure definitions
;RHT 9/74

;GRAPH NODES
	II==0
	XX	NXTGN		;CHAIN OF ALL GNODES IN THE WORLD
	XX	PRVGN		;PREVIOUS LINK IN THE CHAIN
	XX	INVMRK		;USED AS FLAG
	XX	VALIDF		;VALIDITY FLAG:  INCREMENTED WHEN REVALIDATED.
	XX	GNVAL		;POINTER AT VALUE
	XX	GNDEPS		;DEPENDENT GRAPH NODES
	XX	GNCLCS		;CALCULATOR LIST (DBL LINKED)
	XX	GNCHGS		;CHANGE LIST
	GNDSIZ = II/2		;Length of graph cell (in words)

;CELL LINKS
	II==0
	XX	DATUM
	XX	LINKF
	XX	LINKB

;CALCULATOR CELL
	II==0
	XX	NXTCLC		;LIST LINK
	XX	NEEDED		;LIST OF NEEDED NODES
	XX	FORM		;SOME SORT OF CODE TO EVAL

;CHANGER CELL
	II==0
	XX	NXTCHG
	XX	CHGCOD

GNODES:  .BLKW 1		;for chain of graph nodes.
TIME:	0
; NXTTIM
;
;	JSR	PC,NXTTIM
;	
;RETURNS TIME←TIME+1 IN R0
;IF TIME GOES NEGATIVE THEN GOES THRU & SETS ALL POSITIVE MARK
;CELLS TO NEGATIVE, & THEN SETS TIME TO 1


NXTTIM:	INC	TIME		;TIME←TIME+1
	MOV	TIME,R0
	BGT	NXT.RT		;OK?
	MOV	GNODES,R0	;
	BEQ	NXTT.3		;DID WE HAVE ANY??
NXTT.1: TST	INVMRK(R0)	;YES
	BLE	NXTT.2		;WAS INVMRK POSITIVE
	NEG	INVMRK(R0)	;YES, NEGATE IT
NXTT.2:	MOV	NXTGN(R0),R0	;GO ON TO NEXT
	BNE	NXTT.1		;IF ANY
NXTT.3:	INC	R0		;R0←0+1
	MOV	R0,TIME		;TIME IS 1 AGAIN
NXT.RT:	RTS	PC

ROUTINE INVLDT,<INV.ND>
	MOV	INV.ND(RF),R0
	JSR	PC,INVLR0
	RTS	RF

INVLR0:	TST	INVMRK(R0)	;IS IT DEAD YET?
	BNE	INVL.R		;ALREADY INVALID??
INVL.1:	DEC	INVMRK(R0)	;NO, MAKE IT SO
	MOV	R2,-(SP)	;SAFE REGISTER
	MOV	GNDEPS(R0),R2	;DEPENDENTS
	BEQ	INVL.X		;IF ANY 
INVL.2:	MOV	DATUM(R2),R0	;GET A DEPENDENT
	JSR	PC,INVLR0	;AND INVALIDATE IT
	MOV	LINKF(R2),R2	;GO TO NEXT
	BNE	INVL.2		;IF ANY
INVL.X:	MOV	(SP)+,R2	;GET BACK SCRATCH REGISTER
INVL.R:	RTS	PC

ROUTINE CHANGE,<CHG.ND,CHG.VNEW>
	MOV	CHG.ND(RF),R0	;THE NODE
	JSR	PC,INVLR0	;INVALIDATE IT
	MOV	CHG.ND(RF),R0	;SINCE NO PROMISES WERE MADE
	MOV	R2,-(SP)	;SAVE A COUPLE REGISTERS
	MOV	R3,-(SP)
	MOV	GNVAL(R0),R2	;OLD VALUE
	MOV	CHG.VNEW(RF),GNVAL(R0) ;PUT AWAY NEW VALUE
	MOV	GNCHGS(R0),R3	;CHANGERS
	BEQ	CH.XXX		;MAY BE ABOUT DONE
CH.1:	CALL	CRTS,<R2,CHG.VNEW(RF)> ;***** ACTUALLY MUST CALL A CHANGE ROUT HERE
	MOV	NXTCHG(R3),R3	;CDR DOWN LIST
	BNE	CH.1
CH.XXX:	MOV	CHG.ND(RF),R0
	CLR	INVMRK(R0)
	MOV	(SP)+,R3
	MOV	(SP)+,R2
CRTS:	RTS	RF
; I THINK THIS HAS A CONFUSION ABOUT THE CALL TO CRTS.
;  GETVAL, GETVR0

ROUTINE GETVAL,<GTV.ND>
	MOV	GTV.ND(RF),R0
	JSR	PC,GETVR0
	RTS	RF

GETVR0:	TST	INVMRK(R0)	;WAS IT VALID ALREADY
	BEQ	GETV.R		;JUST RETURN IF IT WAS
	MOV	R0,-(SP)	;SAVE EXTRA COPY FOR RANDOMNESS
	MOV	RF,-(SP)
	MOV	R0,-(SP)	;EVALNODE(GTV.ND,TIME←TIME+1)
	JSR	PC,NXTTIM	
	MOV	R0,-(SP)
	MOV	#MARK2,-(SP)
	MOV	SP,RF
	JSR	PC,EVALND		
	MOV	(SP)+,R0	;GET NODE BACK
GETV.R:	MOV	GNVAL(R0),R0	;GET THE VALUE CELL
	RTS	PC		;RETURN

; EVALND, EVLCLC

ROUTINE EVALND,<EVL.ND,EVL.T>
	MOV	EVL.ND(RF),R0
	MOV	INVMRK(R0),R1	;IF INVMRK = 0 
	BEQ	EV.RTS		;THEN RETURN
	CMP	R1,EVL.T(RF)	;IF INVMRK=EVL.T
	BEQ	EV.RTS		;THEN RETURN
	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	R3,-(SP)
	MOV	GNCLCS(R0),R2	;CALCULATORS
	BEQ	EV.XXX		;IF ANY
EV.CLP:	MOV	NEEDED(R2),R3	;NEEDED LIST
	BEQ	EV.NOK		;ALL NEEDS MET YET?
EV.NLP: CALL	EVALND,<DATUM(R3),EVL.T(RF)> ;NO, GET NEXT
	MOV	DATUM(R3),R0	;SEE IF NEED WAS MET?
	TST	INVMRK(R0)	;DID WE WIN
	BNE	EV.NXC		;BRANCH IF STILL NOT VALID
	MOV	LINKF(R3),R3	;TRY NEXT NEEDED
	BNE	EV.NLP		
EV.NOK:	CALL	EVLCLC,<R2>	;EVALUATE CALCULATOR
	MOV	EVL.ND(RF),R1	;PICK UP EVL.ND
	MOV	R0,GNVAL(R1)	;SAVE VALUE IN IT
	CLR	INVMRK(R1)	;REVALIDATE THE NODE
	INC	VALIDF(R1)	;INCREMENT ITS VALIDITY NUMBER
	BR	EV.XXX		;EXIT
EV.NXC:	MOV	NXTCLC(R2),R2	;TRY NEXT CALCULATOR
	BNE	EV.CLP		;IF ANY TO TRY
EV.XXX:
	MOV	(SP)+,R3	;RESTORE ACS
	MOV	(SP)+,R2
EV.RTS:	RTS	RF		;RETURN

ROUTINE EVLCLC,<EVC.CLC>
	RTS	RF
ROUTINE ADDCLC,<ADD.ND,ADD.CLC>
	MOV	R2,-(SP)	;SAVE A REGISTER
	MOV	R3,-(SP)	;SAVE A REGISTER
	MOV	ADD.ND(RF),R3	;THE NODE
	MOV	ADD.CLC(RF),R1	;THE CALCULATOR
	MOV	GNCLCS(R3),NXTCLC(R1) ;CURRENT CALCULATOR LIST
	MOV	NEEDED(R1),R2	;LIST OF NEEDED NODES
	BEQ	ACLC.X		;ALL DONE
ACLC.1:	JSR	PC,GET2WD	;GET A TWO-WORD CELL
	MOV	R3,DATUM(R0)	;THIS NODE IS NOW A DEPENDENT OF
	MOV	DATUM(R2),R1	;THE NEEDED NODE
	MOV	GNDEPS(R1),LINKF(R0) ;ADD IT TO THE DEPENDENTS LIST
	MOV	R0,GNDEPS(R1)	;
	MOV	LINKF(R2),R2	;NEXT NEEDED NODE
	BNE	ACLC.1		;
ACLC.X:	MOV	(SP)+,R3	;RESTORE ACS
	MOV	(SP)+,R2
	RTS	R5

;  MAKEGN, DELGN

MAKEGN:
COMMENT ⊗ Creates a graph node, with no frills (no calculators,
updaters, changers, loksh, boydem, tsibele, ...) except that if R0 is
non-zero, that is assumed to be the value cell pointer.  The space is
taken from large block storage.  The new graph node is returned in R0.
⊗

	MOV R0,-(SP)	;Save R0
	MOV #GNDSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new graph node]
	MOV (SP)+,GNVAL(R0)	;Stuff away the value cell pointer.
	CLR GNDEPS(R0)	;Zero other fields
	CLR GNCLCS(R0)	;
	CLR GNCHGS(R0)	;
	CLR PRVGN(R0)	;I dont know what this is.
	CLR VALIDF(R0)	;
	MOV #-1,R1	;
	MOV R1,#INVMRK(R0);
	MOV GNODES,R1	;Link up to other nodes in the world.
	MOV R1,PRVGN(R0);
	MOV R0,NXTGN(R1);
	MOV R0,GNODES	;
	RTS PC		;

DELGN:
COMMENT ⊗ R0 is the location of the graph node.  Destruction is a
very tricky business.  All dependents must first be validated, then
each must be informed that its calculator has gone away.  The value
cell must be reclaimed.  Temporarily, this means returning it to the
large block allocator.  Warning: this means that graph nodes may not
share value cells.  Then the node itself can be unlinked from the
chain and returned to free storage.  ⊗

	MOV R2,-(SP)	;Save registers
	MOV R3,-(SP)	;Save registers
	MOV R0,R2	;R2 ← Graph node to delete
	MOV GNDEPS(R2),R3	;R3 ← List of dependents
	BEQ DEL1	;If empty, fine.
	JSR PC,NXTTIME	;R0 ← next time
	MOV R0,-(SP)	;Save time
DEL2:	MOV (SP),R0	;Evaluate all dependents with this time.
	CALL EVALND,<DATUM(R3),R0> ;Validate this dependent.
	CALL DELCLC,<DATUM(R3),R2> ;Tell him his calculator is gone
	MOV LINKF(R3),R3;R3 ← CDR(R3)
	BNE DEL2	;Repeat till done
	TST (SP)+	;Get rid of time
	MOV GNDEPS(R2),R0;
	JSR PC,RLLST1	;Release the storage in the dependents list.
DEL1:	MOV GNVAL(R2),R0;
	BEQ DEL3	;Is there a value cell?
	JSR PC,RLFREE	;Yes; return it to free storage.
DEL3:	MOV GNCLCS(R2),R0;
	JSR PC,RLLST2	;Release the double-linked list for calculators
	MOV GNCHGS(R2),R0;
	JSR PC,RLLST1	;Release the change list.
	SETPRI #4	;Want to do something critical
	MOV NXTGN(R2),R1;Unlink this graph node
	MOV PRVGN(R2),R0;
	MOV R0,PRVGN(R1);
	MOV R1,NXTGN(R0);
	SETPRI (SP)+	;Restore old priority
	TST (SP)+	;Get rid of garbage SETPRI leaves on stack
	MOV R2,R0	;
	JSR PC,RLFREE	;Release the graph node itself. (should be done last)
	MOV (SP)+,R3	;Restore register
	MOV (SP)+,R2	;Restore register

	RTS PC		;Done


; DELCLC, RLLST1, RLLST2

ROUTINE DELCLC,<DLC.GN,DLC.GONE>;  

COMMENT ⊗ The graph node pointed to by DLC.GN must have all
calculators removed that depend on DLC.GONE, another graph node.
Effort has already been made to validate DLC.GN, so no need to try it
again.  Just find all such calculators, and get rid of them.  ⊗

	RTS RF		;Temporarily empty

RLLST1:
COMMENT ⊗ Free the storage used by the one-way list pointed to by R0.
Do not do anything to what is pointed to by DATUM(R0).  Just CDR down
LINKF. ⊗

RLLST2:
COMMENT ⊗ Free the storage used by the two-way list pointed to by R0.
Do not do anything to what is pointed to by DATUM(R0).  Just CDR down
LINKF. ⊗
	RTS PC		;Temporarily empty
;GET2WD & GET3WD 

; GET A TWO-WORD CELL (OF POINTERS)
GET2WD:	MOV	#2,R0
	JMP	PC,GTFREE	;This will return to my caller

; GET A THREE-WORD CELL (OF POINTERS)
GET3WD:	MOV	#3,R0
	JMP	PC,GTFREE	;This will return to my caller


COMMENT ⊗ RF -- This is RHT's, temporarily commented out.

W2SPC:	SPC	W2ID,MP2WD,2,20,1,20,25
W3SPC:	SPC	W3ID,MP3WD,3,20,1,20,25

MP2WD:	TSTB	TAG(R0)
	BNE	MPRTS		;ALREADY DID THIS ONE
	JSR	PC,@2(RF)	;
	MOV	R2,-(SP)	;
	MOV	R0,R2		;SAVE RESULT OF ROUT
MPDLF:	MOV	DATUM(R2),R0	;DO DATUM
	JSR	PC,MARKR0	;
	MOV	R0,DATUM(R2)	;
	MOV	LINKF(R2),R0	;DO LINKF
	JSR	PC,MARKR0	;A LONG LIST WILL PDLOV (ALAS)
	MOV	R0,LINKF(R2)	; BUT WE DONT HAVE ANY LONG LISTS (I HOPE)
	MOV	R2,R0		;RETURN VALUE
	MOV	(SP)+,R2	;
MPRTS:	RTS	PC

MP3WD:	TSTB	TAG(R0)		;DID WE DO THIS
	BNE	MPRTS		;YES
	JSR	PC,@2(RF)	;
	MOV	R2,-(SP)
	MOV	R0,R2
	MOV	LINKB(R2),R0	;DO LINKB
	JSR	PC,MARKR0
	MOV	R0,LINKB(R2)	;
	BR	MPDLF		;GO DO DATUM & LINKF

⊗  END OF COMMENTED OUT PART